home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol020 / rbbspc.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-11  |  22.4 KB  |  553 lines
  1. 10       ' RBBS-I/O.BAS   Remote Bullettin Board Program
  2. 20       ' This Version Also Performs The Sign-On Functions & Modem I/O
  3. 30       ' Author - Russ Lane  - 6/21/82  -  (C)Copyright  1982
  4. 35       ' See RBBS-I/O.DOC
  5. 40       ' Gripes, Problems, Suggestions, Modifications, And Praise
  6. 50       ' Are More Than Welcome.  312-251-3067 (voice) -  312-251-0168 (data)
  7. 60  A$=MID$(R$,A+1,C) : IF EOL THEN 9080
  8. 65  D$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  9. 70  ON ERROR GOTO 13000
  10. 80  DEFINT A-Z : CR$=CHR$(13) : LF$=CHR$(10) : TB$=CHR$(9)
  11. 90  BK$=CHR$(8)+CHR$(32)+CHR$(8) : BK1$=CHR$(29)+CHR$(32)+CHR$(29)
  12. 95  GOSUB 100 : GOTO 200
  13. 100              ' Write Record #, Msg #, to Array -----------------------------
  14. 105  CLOSE #1,2 : DIM M(500,2)   'M(Record #,Msg #)        500 is max # of msgs.
  15. 110  R=1 : OPEN "R",#1,"MESSAGES" : FIELD #1,128 AS R$
  16. 120  GET 1,R : IF INSTR(R$,CHR$(226))>1 THEN DEAD=-1 ' If it's killed...
  17. 130  RR=VAL(MID$(R$,118)) : IF DEAD THEN 150 ELSE IF RR<1 THEN 160
  18. 140  LASTR=LASTR+1 : M(LASTR,1)=R : M(LASTR,2)=VAL(LEFT$(R$,5))
  19. 150  R=R+RR : DEAD=0 : GOTO 120
  20. 160  FIRSTM=M(1,2) : LASTM=M(LASTR,2) : RETURN
  21. 200              ' Wait for Caller to Call -------------------------------------
  22. 210  OPEN "COM1:300,N,8,1" AS #3
  23. 220  IF XPR THEN A$="Expert Mode" ELSE A$="Novice Mode"
  24. 230  WHILE EOF(3)
  25. 234  IF INKEY$=CHR$(27) THEN PRINT "Sysop is in.":CLOSE 3:LOCAL=-1:GOTO 450
  26. 236  WEND
  27. 238  WHILE INPUT$(2,3)<>STRING$(2,13) : WEND
  28. 240  WIDTH 80:SCREEN 0,0,0:KEY OFF : TI$=TIME$
  29. 250  A$="Do you need line feeds ? ":CR=1:GOSUB 1400:Z$=INPUT$(1,#3):GOSUB 5000
  30. 255  IF Z$="Y" THEN LF=-1 ELSE IF Z$="N" THEN LF=0 ELSE GOSUB 1400:GOTO 250
  31. 257  A$=Z$ : CR=2 : GOSUB 1400
  32. 260  RET=1:STI=-1:FILE$="WELCOME" :GOSUB 6000 'STI Enables Interrupts (Ctrl-K)
  33. 270  RET=2:STI=-1:FILE$="BULLETIN":GOSUB 6000 'RET Will Return To Here From ^K
  34. 280  CR=2:GOSUB 1400:TRIES=0:STI=0   'Interrupts Off
  35. 300             ' Get Caller's Name --------------------------------------------
  36. 305  IF TRIES>5 THEN 12000 ' Log-Off Nicely
  37. 310  TRIES=TRIES+1:GOSUB 1400:A$="What is your FIRST Name":GOSUB 1500
  38. 320  IF Q=0 THEN 300 ELSE Z$=B$(1):GOSUB 5000:FIRST$=Z$:IF Q=1 THEN 340
  39. 330  Z$=B$(2):GOSUB 5000:LAST$=Z$:GOTO 370
  40. 340  A$="What is your LAST  Name":GOSUB 1500
  41. 350  Z$=B$(1):GOSUB 5000:LAST$=Z$
  42. 370  IF LEN(FIRST$)<2 OR LEN(LAST$)<2 THEN 300
  43. 380  IF FIRST$="PASS" AND LAST$="WORD" THEN 450    'Place Sysop's Password Here
  44. 390  NAM$=FIRST$+CHR$(32)+LAST$
  45. 400  IF INSTR(NAM$,"SYSOP")OR INSTR(NAM$,"RUSS LANE")THEN 12500 'Log-Off Wiseguy
  46. 410  FOR Q=1 TO LEN(NAM$)
  47. 430  X=ASC(MID$(NAM$,Q,1)) : IF (X<65 OR X>90) AND (X<>32 AND X<>39) THEN 300
  48. 440  NEXT : GOSUB 1400 : GOTO 500
  49. 450  FIRST$="RUSS":LAST$="LANE":NAM$="SYSOP":SYSOP=-1:BELL=0:XPR=-1:GOTO 1200
  50. 500             ' Check Last Caller --------------------------------------------
  51. 510  OPEN "I",#2,"LASTCALR" : INPUT #2,N$,CALLN : CLOSE #2
  52. 520  IF NAM$<>N$ THEN 600
  53. 530  LASTCALR=-1 : A$="Welcome back, "+FIRST$ : CR=2 : GOSUB 1400 : GOTO 820
  54. 600             ' Check User File ---------------------------------------------
  55. 610  A$="Checking User File..." : CR=2 : GOSUB 1400
  56. 620  OPEN "I",#2,"USERS"
  57. 630  IF EOF(2) THEN CLOSE #2:GOTO 700
  58. 640  INPUT #2,N$,CITY$,STATE$,STATU$
  59. 650  IF NAM$<>N$ THEN 630
  60. 660  CLOSE #2
  61. 670  IF STATU$="OK" THEN 810 ' Can Access System
  62. 680  GOTO 12530              ' Log-Off Weasel
  63. 700             ' Get New User's Background ------------------------------------
  64. 710  NEWCALR=-1
  65. 720  A$="What CITY  are you calling from":GOSUB 1500
  66. 730  IF Q=0 THEN 300 ELSE Z$=B$(1) : GOSUB 5000 : CITY$=Z$
  67. 740  A$="What STATE are you calling from":GOSUB 1500
  68. 750  IF Q=0 THEN 720 ELSE Z$=B$(1) : GOSUB 5000 : STATE$=Z$
  69. 760  A$=TB$+NAM$:GOSUB 1400
  70. 770  A$=TB$+CITY$+", "+STATE$:CR=2:GOSUB 1400
  71. 780  A$="Is this correct":GOSUB 1500:GOSUB 1400:IF NOT YES THEN 300
  72. 790  OPEN "A",#2,"USERS" : WRITE #2,NAM$,CITY$,STATE$,"OK" : CLOSE #2
  73. 795  A$="This is only done the first time you call, "+FIRST$ : CR=2 : GOSUB 1400
  74. 800             ' Log To Disk -------------------------------------------------
  75. 810  A$="Logging "+NAM$+" to disk..." : CR=2 : GOSUB 1400
  76. 820  OPEN "O",#2,"LASTCALR" : CALLN=CALLN+1
  77. 830  WRITE #2,NAM$,CALLN : CLOSE #2
  78. 840  OPEN "A",#2,"CALLERS"
  79. 850  PRINT #2,NAM$;"  ";D$;"  ";TI$ : CLOSE #2
  80. 860  IF LASTCALR OR NEWCALR OR SYSOP THEN 1040 ' Bypass Search For Msgs
  81. 900             ' Search for any messages to this caller ----------------------
  82. 920  A$="I'm seeing if there are messages waiting for you...":CR=2 : GOSUB 1400
  83. 930  X=37:Y=31:F$=NAM$:T=0:DONE=0:R=1
  84. 950  GET 1,R : RR=VAL(MID$(R$,118)) : R=R+RR : IF RR<1 THEN 970
  85. 960  IF INSTR(MID$(R$,37,31),NAM$)>0 THEN 980 ELSE 950
  86. 970  IF T THEN 1040 ELSE 1030
  87. 980  IF T THEN 1020
  88. 990   A$="The following message(s) was/were left for you.":GOSUB 1400
  89. 1000  A$="Please (K)ill those that would not interest other callers."
  90. 1010  GOSUB 1400:T=-1
  91. 1020  A$=LEFT$(R$,5):CR=1:GOSUB 1400:GOTO 950
  92. 1030  A$="Nope.  No messeges for you, "+FIRST$
  93. 1040  CR=2 : GOSUB 1400 : A$="Entering The Messege Sub-System..." : GOSUB 1400
  94. 1050  LOCATE 25,1:PRINT SPACE$(80-(LEN(NAM$)+10));NAM$;"  ";TI$
  95. 1060  XPR=0 : BELL=-1 : MARGIN=64
  96. 1070  RET=0 : GOSUB 4900 : STI=-1 : GOSUB 1700
  97. 1200             ' Command Dispatcher ------------------------------------------
  98. 1210  STI=-1:RET=0:Q=0           'Interrupts On,  Return To Here On A Ctrl-K
  99. 1220  ERASE B$
  100. 1230  GOSUB 1400
  101. 1240  IF SYSOP THEN GOSUB 10000
  102. 1250  A$="Function"
  103. 1260  IF NOT XPR THEN A$=A$+"  <B,C,E,G,H,K,L,P,Q,R,S,X,Y,#,? >"
  104. 1270  GOSUB 1500:IF Q=0 THEN 1250
  105. 1280  FOR J=1 TO Q
  106. 1290  Z$=B$(J):GOSUB 5000
  107. 1300  FF=INSTR("?BCEGHKLPQRSXY#$%^&*(",Z$)
  108. 1310  IF FF=0 THEN 1360 ELSE IF FF>15 AND NOT SYSOP THEN 1360
  109. 1320  '           ?    B    C    E    G     H     K     L     P     Q     R
  110. 1330  ON FF GOSUB 1700,1720,1800,2000,12000,1740, 3900, 4100, 4150, 4310, 4320, <UNK! {000A}>                 4330,4200,4700,4900,10100,10120,10200,10400,10600,10800
  111. 1340  '           S    X    Y    #    $     %     ^     &     *     (
  112. 1350  NEXT J : GOTO 1200
  113. 1360  IF XPR THEN 1250 ELSE GOSUB 1400
  114. 1370  A$=FIRST$+", I don't understand "+B$(J):GOSUB 1400:GOTO 1200
  115. 1380  '
  116. 1390  '
  117. 1400             ' Print string ------------------------------------------------
  118. 1402  Y$=INKEY$ : IF LOCAL THEN 1430
  119. 1405  IF EOF(3) THEN 1430
  120. 1410  Y$=INPUT$(1,#3)
  121. 1420  IF Y$=CHR$(19) THEN WHILE EOF(3) : WEND    ' Ctrl-S
  122. 1430  IF Y$=CHR$(11) AND STI THEN 1480           ' Ctrl-K
  123. 1440  LOCATE ,,1 : PRINT A$; : IF LOCAL THEN 1450
  124. 1445  PRINT #3,A$;
  125. 1450  IF CR=1 THEN 1470
  126. 1460  PRINT : IF LOCAL THEN 1465
  127. 1462  PRINT #3,"" : IF LF THEN PRINT #3,CR$+LF$
  128. 1465  IF CR=2 THEN CR=0 : GOTO 1460
  129. 1470  Y$="" : A$="" : CR=0 : RETURN
  130. 1480  CLOSE #2 : A$="++ Aborted ++" : GOSUB 1400 : ON RET GOTO 270,280
  131. 1490  RETURN 1200
  132. 1500             ' Input string ------------------------------------------------
  133. 1510  A=0:B=0:C=0:Q=1:EOL=0:YES=0:B$=""
  134. 1520  A$=A$+" ? "
  135. 1530  IF BELL THEN A$=A$+CHR$(7)
  136. 1540  CR=1 : GOSUB 1400 : IF LOCAL THEN INPUT "",B$ : GOTO 1575
  137. 1550  WHILE EOF(3)
  138. 1552  Y$=INKEY$ : IF Y$<>"" THEN 1562
  139. 1554  WEND
  140. 1560    Y$=INPUT$(1,#3)
  141. 1562    IF Y$=CHR$(8) THEN 1670
  142. 1564    PRINT Y$; : PRINT #3,Y$;
  143. 1566    IF Y$=CR$ THEN 1570
  144. 1568    B$=B$+Y$ : GOTO 1550
  145. 1570  IF LF THEN PRINT #3,CR$+LF$
  146. 1575  A=INSTR(B$,";") : IF A=0 THEN 1640
  147. 1580  B$(1)=LEFT$(B$,A-1)
  148. 1582  B=INSTR(A+1,B$,";")
  149. 1584  C=B-(A+1) : IF C<1 THEN EOL=-1 : C=50 '50 insures all rightmost characters
  150. 1590  BB$=MID$(B$,A+1,C)
  151. 1600  IF BB$<>"" THEN Q=Q+1:B$(Q)=BB$
  152. 1610  IF NOT EOL THEN A=B:GOTO 1582
  153. 1620  IF LEN(B$)=>20 THEN A$="Try again, ";FIRST$ : GOSUB 1400 : GOTO 1500
  154. 1630  RETURN
  155. 1640  B$(1)=B$ : IF B$="" THEN Q=0
  156. 1650  IF LEFT$(B$,1)="Y" OR LEFT$(B$,1)="y" THEN YES=-1
  157. 1660  RETURN
  158. 1670  IF LEN(B$)=0 THEN 1550
  159. 1680  B$=LEFT$(B$,LEN(B$)-1)
  160. 1690  PRINT BK1$; : PRINT #3,BK$; : GOTO 1550
  161. 1700            ' ? Type Functions Supported -----------------------------------
  162. 1710  FILE$="HELP02":GOSUB 6000:RETURN
  163. 1720            ' Type Bulletins -----------------------------------------------
  164. 1730  FILE$="BULLETIN":GOSUB 6000:RETURN
  165. 1740            ' Type Help File -----------------------------------------------
  166. 1750  FILE$="HELP01":GOSUB 6000:RETURN
  167. 1800            ' Comments -----------------------------------------------------
  168. 1810  GOSUB 1400:A$="Comments are only readable by Sysop.":GOSUB 1400:MARGIN=64
  169. 1820  A$="Do you wish to leave any":GOSUB 1500
  170. 1830  IF NOT YES THEN A$="No comment.":GOSUB 1400:RETURN
  171. 1840  LI=0:DIM A$(30)
  172. 1850  GOSUB 1400:A$="Enter up to 20 lines. (lone C/R to end):GOSUB 1400
  173. 1860  GOSUB 1400:GOSUB 3200
  174. 1870  R$="":LI=LI+1:A$="   "+STR$(LI)+": "+A$(LI):IF LI<10 THEN A$=" "+A$
  175. 1880  CR=1 : GOSUB 1400 : GOSUB 3700
  176. 1890  IF A$(LI)="" THEN LI=LI-1:IF LI<1 THEN ERASE A$:RETURN ELSE 1940
  177. 1900  IF LI=18 THEN A$="Two lines left...":GOSUB 1400
  178. 1910  IF LI=19 THEN A$="Last line.":GOSUB 1400
  179. 1920  IF LI=20 AND NOT SYSOP THEN A$="Comment full.":GOSUB 1400:GOTO 1940
  180. 1930  GOTO 1870
  181. 1940  OPEN "A",#2,"COMMENTS"
  182. 1950  GOSUB 1400:A$="Many thanks for the comments, "+FIRST$:GOSUB 1400
  183. 1960  PRINT #2,NAM$,D$,TIME$
  184. 1970  FOR X=1 TO LI:PRINT #2,A$(X):NEXT
  185. 1980  FOR X=1 TO 2 :PRINT #2,CHR$(13):NEXT:CLOSE #2:ERASE A$:RETURN
  186. 2000            ' Enter A Messege --------------------------------------------
  187. 2010  GOSUB 1400:T$="":PAS$="":LI=0:L=0:X=0:BEGIN=0
  188. 2030  DIM A$(30)
  189. 2040  A$="Messege will be # "+STR$(LASTM+1) : GOSUB 1400
  190. 2050  A$="Who To <C/R  For All>":GOSUB 1500
  191. 2060  IF LEN(B$(1))>30 THEN A$="30 Chars max.":GOSUB 1400:GOTO 2050
  192. 2070  IF Q=0 THEN T$="ALL" ELSE Z$=B$(1):GOSUB 5000:T$=Z$
  193. 2080  A$="Subject":GOSUB 1500
  194. 2090  IF LEN(B$(1))>25 THEN A$="25 Chars max.":GOSUB 1400:GOTO 2080
  195. 2100  IF Q=0 THEN 2050 ELSE Z$=B$(1):GOSUB 5000:SUB$=Z$
  196. 2110  A$="Protect  <K,R,N,?>":IF XPR THEN 2130
  197. 2120  A$="Protect  < <K>ill, <R>ead, <N>one, <?>Help >"
  198. 2130  GOSUB 1500:Z$=LEFT$(B$(1),1):GOSUB 5000:IF Z$="N" THEN 2190
  199. 2140  IF Z$="?" THEN FILE$="HELP03":GOSUB 6000:GOTO 2120
  200. 2150  IF Z$="K" THEN 2170
  201. 2160  IF Z$="R" THEN PAS$="^READ^":GOTO 2190
  202. 2165  GOTO 2080
  203. 2170  A$="Password":GOSUB 1500
  204. 2180  IF LEN(B$(1))>15 THEN A$="15 Chars. max.":GOSUB 1400:GOTO 2170 
  205. 2185  PAS$=B$(1)
  206. 2190  GOSUB 1400:IF XPR THEN 2212
  207. 2200  A$="To enter message, type in lines.":GOSUB 1400
  208. 2210  A$="To edit, type lone C/R.   20 lines max.":GOSUB 1400
  209. 2212  A$="Right-Margin is set at"+STR$(MARGIN):GOSUB 1400
  210. 2214  A$="Do you wish to change it":GOSUB 1500
  211. 2216  IF YES THEN BEGIN=-1:GOTO 3100
  212. 2218  BEGIN=0:GOSUB 3200
  213. 2220  R$="" : LI=LI+1 : A$="   "+STR$(LI)+": "+A$(LI):IF LI<10 THEN A$=" "+A$
  214. 2230  CR=1 : GOSUB 1400:GOSUB 3700
  215. 2240  IF A$(LI)="" THEN LI=LI-1:GOTO 2310
  216. 2250  IF LI=18 THEN A$="Two lines left...":GOSUB 1400
  217. 2260  IF LI=19 THEN A$="Last line.":GOSUB 1400
  218. 2270  IF LI=20 AND NOT SYSOP THEN A$="Messege full.":GOSUB 1400:GOSUB 2300
  219. 2280  GOTO 2220
  220. 2300             'Editing dispatcher ------------------------------------------
  221. 2305  GOSUB 1400
  222. 2310  IF XPR THEN A$="Function  <A,C,D,E,I,L,M,S,? >":GOTO 2340
  223. 2320  A$="Functions : <A>bort, <C>ontinue, <D>elete, <E>dit,":GOSUB 1400
  224. 2330  A$="            <I>nsert, <L>ist, <M>argin, <S>ave, <?>Help "
  225. 2340  GOSUB 1500:IF Q=0 THEN 2310 ELSE Z$=B$(1):GOSUB 5000
  226. 2350  IF Q>1 AND Z$<>"M" THEN L=VAL(B$(Q)):GOSUB 3320 'Test validity of line #
  227. 2360  FF=INSTR("ACDEILMS?",Z$):IF FF<1 OR FF>9 THEN 2310
  228. 2370  ON FF GOTO 2400,2380,2500,2600,2800,3000,3100,3400,2390
  229. 2380  GOSUB 3200:GOTO 2250   'Continue
  230. 2390  FILE$="HELP04":GOSUB 6000:GOTO 2320
  231. 2400             'Abort -------------------------------------------------------
  232. 2410  GOSUB 1400:A$="Do you confirm Abortion":GOSUB 1500
  233. 2420  IF NOT YES THEN 2300
  234. 2430  GOSUB 1400:A$="Aborted.":GOSUB 1400:ERASE A$:RETURN 1200
  235. 2500             'Delete A Line -----------------------------------------------
  236. 2510  GOSUB 1400:IF Q=1 THEN A$="Delete ":CR=1:GOSUB 1400:GOSUB 3300
  237. 2520  A$="Line #"+STR$(L) : GOSUB 1400 : A$=A$(L) : CR=2 : GOSUB 1400
  238. 2530  A$="Do You Confirm Deletion":GOSUB 1500
  239. 2540  IF NOT YES THEN A$="Line #"+STR$(L)+" NOT Deleted.":GOSUB 1400:GOTO 2300
  240. 2550  FOR X=L TO LI:A$(X)=A$(X+1):NEXT:LI=LI-1
  241. 2560  A$="Line #"+STR$(L)+" Deleted.":GOSUB 1400:GOTO 2300
  242. 2600             'Edit A Line -------------------------------------------------
  243. 2610  GOSUB 1400:IF Q=1 THEN GOSUB 3300
  244. 2620  A$="Line # "+STR$(L)+" Was :":GOSUB 1400:A$=A$(L):CR=2:GOSUB 1400
  245. 2630  A$="Enter  Oldstring;Newstring  or  C/R for no change.":GOSUB 1400
  246. 2640  GOSUB 1400:GOSUB 1500
  247. 2650  IF Q=0 THEN 2300
  248. 2660  X=INSTR(1,A$(L),B$(1)):IF X=0 THEN 2720
  249. 2680  LB1=LEN(B$(1)):LB2=LEN(B$(2)):IF LB1<>LB2 THEN 2700
  250. 2690  MID$(A$(L),X)=B$(2):GOTO 2620
  251. 2700  C$=MID$(A$(L),X+LB1):CC$=LEFT$(A$(L),X-1)
  252. 2710  A$(L)=CC$+B$(2)+C$:GOTO 2620
  253. 2720  A$="String  '"+B$(1)+"' not found in line "+STR$(L):GOSUB 1400:GOTO 2300
  254. 2800             'Insert A Line -----------------------------------------------
  255. 2810  DIM C$(30)
  256. 2820  GOSUB 1400:IF Q=1 THEN A$="Before ":CR=1:GOSUB 1400:GOSUB 3300
  257. 2830  W=LI:K=LI-L:FOR X=L TO LI:C$(X+1-L)=A$(X):A$(X)="":NEXT : LI=L
  258. 2840  R$="":A$=STR$(LI)+": ":IF LI<10 THEN A$=" "+A$
  259. 2850  CR=1:GOSUB 1400:GOSUB 3700
  260. 2860  IF A$(LI)="" THEN 2920
  261. 2870  LI=LI+1
  262. 2880  IF LI+K=18 THEN A$="Two lines left...":GOSUB 1400
  263. 2890  IF LI+K=19 THEN A$="Last line.":GOSUB 1400
  264. 2900  IF LI+K=20 AND NOT SYSOP THEN A$="Messege full.":GOSUB 1400:GOTO 2920
  265. 2910  GOTO 2840
  266. 2920  FOR X=1 TO K+1:A$(LI+X-1)=C$(X):NEXT:LI=W+LI-L
  267. 2930  ERASE C$ : GOTO 2300
  268. 3000             'List Lines --------------------------------------------------
  269. 3010  GOSUB 1400:GOSUB 3200
  270. 3020  FOR X=1 TO LI:A$="   "+STR$(X)+": "+A$(X):IF X<10 THEN A$=" "+A$
  271. 3030  GOSUB 1400:NEXT:GOSUB 1400:GOTO 2300
  272. 3100             'Set Right Margin --------------------------------------------
  273. 3110  GOSUB 1400:IF Q<>1 THEN B$(1)=B$(Q):GOTO 3130
  274. 3120  A$="Set Right-Margin to (8,16,24,32,40,48,56,64) ":GOSUB 1500
  275. 3130  FOR X=8 TO 64 STEP 8:IF VAL(B$(1))=X THEN 3150 ELSE NEXT
  276. 3140  A$="Invalid - Margin remains at"+STR$(MARGIN):GOSUB 1400:GOTO 3160
  277. 3150  MARGIN=VAL(B$(1)):A$="Margin now set to"+STR$(MARGIN):GOSUB 1400
  278. 3160  IF BEGIN THEN 2218 ELSE 2300
  279. 3200             'Print Tab Settings ------------------------------------------
  280. 3210  GOSUB 1400:A$=TB$+"!" : CR=1 : GOSUB 1400
  281. 3220  FOR X=8 TO MARGIN STEP 8:A$="-------!":CR=1:GOSUB 1400:NEXT:GOSUB 1400:RETURN
  282. 3300             'Test Line Number --------------------------------------------
  283. 3310  A$="Line #":GOSUB 1500:L=VAL(B$(1)):'PRINT B$(1)
  284. 3320  IF L=>1 AND L=<LI THEN RETURN
  285. 3330  IF Q=0 THEN RETURN 2300
  286. 3340  IF ASC(B$(1))<49 AND ASC(B$(1))>57 THEN RETURN 1200
  287. 3350  A$="No such line, "+FIRST$:GOSUB 1400:GOTO 2300
  288. 3400             'Save Messege ------------------------------------------------
  289. 3410  GOSUB 1400:A$="Updating Msg file.":CR=1:GOSUB 1400
  290. 3420  CLOSE #2:OPEN "O",#2,"LASTCALR" : LASTM=LASTM+1 : LASTR=LASTR+1
  291. 3430  WRITE #2,NAM$,D$,TI$,STATUS,CALLN : CLOSE #2
  292. 3440             '
  293. 3450  REC=0:N$=""
  294. 3460  MNUM$=STR$(LASTM)+SPACE$(5-LEN(STR$(LASTM)))'1-5
  295. 3470  FROM$=NAM$+SPACE$(31-LEN(NAM$))             '6-36
  296. 3480  T$=T$+SPACE$(31-LEN(T$))                    '37-67
  297. 3490  SUB$=SUB$+SPACE$(25-LEN(SUB$))              '76-100
  298. 3500  PAS$=PAS$+SPACE$(15-LEN(PAS$))              '101-115
  299. 3510  FOR J=1 TO LI:A$(J)=A$(J)+CHR$(227):REC=REC+LEN(A$(J)):NEXT J
  300. 3520  IF REC MOD 128=0 THEN N$=STR$(REC\128+1) ELSE N$=STR$(REC\128+2)
  301. 3530  CLOSE #1:OPEN "R",#1,"MESSAGES" : FIELD #1,128 AS R$
  302. 3540  GET 1,LOF(1)/128 : M(LASTR,1)=LOC(1)+1 : M(LASTR,2)=LASTM
  303. 3550  M(LASTR,1)=LOC(1)+1 : M(LASTR,2)=LASTM
  304. 3560  LSET R$=MNUM$+FROM$+T$+D$+SUB$+PAS$+CHR$(225)+N$ : PUT 1
  305. 3600             'Pack Disk Record --------------------------------------------
  306. 3610  FOR J=1 TO LI:A$=".":CR=1:GOSUB 1400
  307. 3620  FOR K=1 TO LEN(A$(J))
  308. 3630  E$=E$+MID$(A$(J),K,1)
  309. 3640  IF LEN(E$)>127 THEN LSET R$=E$:PUT 1:E$=""
  310. 3650  NEXT K
  311. 3660  NEXT J
  312. 3670  LSET R$=E$:PUT 1:E$=""
  313. 3680  ERASE A$:RETURN
  314. 3700            'Word Processor -----------------------------------------------
  315. 3710  COL=COL+1:IF LOCAL THEN X$=INPUT$(1) ELSE X$=INPUT$(1,3)
  316. 3720  IF X$=CHR$(8) THEN 3850 ELSE IF X$=CHR$(9) THEN P=POS(0)
  317. 3730  A$=X$ : CR=1 : GOSUB 1400 : IF X$=CHR$(9) THEN COL=COL+(POS(0)-P)
  318. 3740  IF X$=CHR$(13) THEN 3840
  319. 3750  IF COL>MARGIN-3 AND X$=CHR$(32) THEN GOSUB 1400:GOTO 3840
  320. 3760  R$=R$+X$
  321. 3770  IF COL<MARGIN+1 THEN 3710
  322. 3780  IF X$=CHR$(32) THEN GOSUB 1400:GOTO 3840
  323. 3790  Z=MARGIN+1
  324. 3800  WHILE (MID$(R$,Z,1)<>" " AND MID$(R$,Z,1)<>"" AND MID$(R$,Z,1)<>CHR$(9))
  325. 3810  Z=Z-1:IF Z>0 THEN WEND ELSE GOSUB 1400:GOTO 3840
  326. 3820  COL=MARGIN+1-Z : PRINT STRING$(COL,29)+STRING$(COL,0);
  327. 3825  IF NOT LOCAL THEN PRINT #3,STRING$(COL,8)+STRING$(COL,32);
  328. 3830  A$(LI)=LEFT$(R$,Z):A$(LI+1)=RIGHT$(R$,COL):GOSUB 1400:RETURN
  329. 3840  A$(LI)=A$(LI)+R$:COL=0:RETURN
  330. 3850  COL=COL-2:R$=LEFT$(R$,LEN(R$)-1)
  331. 3860  PRINT BK1$; : IF NOT LOCAL THEN PRINT #3,BK$;
  332. 3870  GOTO 3710
  333. 3900             'Kill A Message ---------------------------------------------
  334. 3905  GOSUB 1400
  335. 3910  IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 3930
  336. 3920  A$="Msg # to Kill":GOSUB 1500:MM=VAL(B$(Q)):GOSUB 1400
  337. 3926  IF MM=0 THEN RETURN
  338. 3930  FOR Q=1 TO LASTR : IF M(Q,2)=MM THEN 3950 ELSE NEXT
  339. 3940  A$="No Msg # "+STR$(MM):GOSUB 1400:RETURN 1200
  340. 3950  GET 1,M(Q,1) : R=VAL(MID$(R$,118)) : IF SYSOP THEN 4030
  341. 3960  Z=15:Z$=MID$(R$,101,15) : GOSUB 8100 : PAS$=Z$
  342. 3990  IF PAS$="^READ^" THEN IF INSTR(R$,NAM$) THEN 4030 ELSE 4020
  343. 4000  A$="Password":GOSUB 1500
  344. 4010  IF B$(1)=PAS$ THEN 4030
  345. 4020  A$="Sorry Buckwheat, you lose.":GOSUB 1400:RETURN 1200
  346. 4030  LSET R$=LEFT$(R$,115)+CHR$(226)+MID$(R$,117) : PUT 1,LOC(1)
  347. 4040  IF Q>1 THEN GET 1,M(Q-1,1)
  348. 4050  M(Q,1)=VAL(MID$(STR$(VAL(MID$(R$,118))+R),2)) : LASTR=LASTR-1
  349. 4060  FOR Q=Q TO LASTR:M(Q,1)=M(Q+1,1):M(Q,2)=M(Q+1,2):NEXT
  350. 4070  FIRSTM=M(1,2) : LASTM=M(LASTR,2)
  351. 4080  A$="Msg # "+STR$(MM)+" Killed.":GOSUB 1390:RETURN 1200
  352. 4100             'Toggle Line Feeds --------------------------------------------
  353. 4110  GOSUB 1400:LF=NOT LF
  354. 4120  A$="Line Feeds ":IF LF THEN A$=A$+"On" ELSE A$=A$+"Off"
  355. 4130  GOSUB 1400:RETURN
  356. 4150             'Toggle Bell --------------------------------------------------
  357. 4160  GOSUB 1400:BELL=NOT BELL
  358. 4170  A$="Prompting Bell ":IF BELL THEN A$=A$+"On" ELSE A$=A$+"Off"
  359. 4180  GOSUB 1400:RETURN
  360. 4200             'Toggle Expert ------------------------------------------------
  361. 4210  GOSUB 1400:XPR=NOT XPR
  362. 4230  GOSUB 1400:RETURN
  363. 4300             'Quick Scan & Summary & Retrieval -----------------------------
  364. 4310  QU=-1:RT=0 :SU=0:GOTO 4340 'Quick Scan Entry Point
  365. 4320  QU=0 :RT=-1:SU=0:GOTO 4340 'Retreival  Entry Point
  366. 4330  QU=0 :RT=0 :SU=-1          'Summarize  Entry Point
  367. 4340  FOW=0:REV=0:RP=0 'Forward Flag, Reverse Flag, Read Protect Flag
  368. 4350  IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 4390
  369. 4360  A$="Msg #  ("+STR$(FIRSTM)+" to"+STR$(LASTM)+" )":IF XPR THEN 4380
  370. 4370  IF RT THEN A$=A$+" to Retreive ( C/R to end)" ELSE A$="Starting at "+A$
  371. 4380  GOSUB 1500:MM=VAL(B$(1))
  372. 4390  IF VAL(B$(Q))=0 THEN RETURN 1200 ELSE GOSUB 1400
  373. 4400  IF RIGHT$(B$(Q),1)="+" THEN FOW=-1
  374. 4410  IF RIGHT$(B$(Q),1)="-" THEN REV=-1:GOTO 4460
  375. 4420  FOR Q=1 TO LASTR
  376. 4430  IF RT AND M(Q,2)=MM THEN 4490
  377. 4440  IF ( (RT AND FOW) OR QU OR SU) AND M(Q,2)=>MM THEN 4490
  378. 4450  NEXT : PRINT "No Msg # "+STR$(MM):RETURN 1200
  379. 4460  FOR Q=LASTR TO 1 STEP -1
  380. 4470  IF M(Q,2)<=MM THEN 4510
  381. 4480  NEXT : A$="No Msg # "+STR$(MM):GOSUB 1400:RETURN 1200
  382. 4490  IF FOW THEN 4500 ELSE IF RT THEN 4530
  383. 4500  QQ=Q : QQQ=LASTR : QQQQ=1 : GOTO 4520
  384. 4510  QQ=Q : QQQ=1     : QQQQ=-1
  385. 4520  FOR Q=QQ TO QQQ STEP QQQQ
  386. 4530  GET 1,M(Q,1)
  387. 4535  IF NOT SYSOP THEN IF INSTR(R$,"^READ^")>0 AND INSTR(R$,NAM$)=0 THEN 4590
  388. 4537  IF QU THEN Z$=MID$(R$,76,25):Z=25:GOSUB 8100
  389. 4540  IF QU THEN A$=STR$(M(Q,2))+"  "+Z$:GOSUB 1400:GOTO 4570
  390. 4550  GOSUB 8000:IF SU THEN 4570
  391. 4560  GOSUB 9000:IF RT AND (NOT FOW AND NOT REV) THEN Q=1:GOTO 4340
  392. 4570  NEXT Q
  393. 4580  GOSUB 1400:A$="End of Msgs.":GOSUB 1400:RETURN 1200
  394. 4590  IF FOW OR REV OR SU OR QU THEN 4570
  395. 4600  A$="Sorry, "+FIRST$+".  Msg #"+STR$(MM)+" is read protected."
  396. 4610  GOSUB 1400:Q=0:GOTO 4340
  397. 4700             'Y Chat -------------------------------------------------------
  398. 4710  GOSUB 1400 : A$="Chat... Remote Conversation Utility." : CR=2 : GOSUB 1400
  399. 4720  A$="Program returns to command level within" : GOSUB 1400
  400. 4730  A$="30 seconds if operator is unavailable" : CR=2 : GOSUB 1400
  401. 4740  K=0 : A$="Alerting operator now" : CR=1 : GOSUB 1400
  402. 4750  FOR I=1 TO 20
  403. 4760  FOR J=1 TO 500 : NEXT J
  404. 4770  K=K+1 : IF INKEY$=CHR$(27) THEN 4830
  405. 4780  IF K MOD 2 THEN A$=CHR$(7) : CR=1 : GOSUB 1400
  406. 4790  A$=". " : CR=1 : GOSUB 1400 : NEXT I : GOSUB 1400
  407. 4800  A$="Sorry "+FIRST$+", no operator available." : GOSUB 1400
  408. 4810  A$="Please leave a message on the board or in the comments."
  409. 4820  GOSUB 1400 : RETURN
  410. 4830  GOSUB 1400 : A$="Operator is available." : GOSUB 1400
  411. 4840  A$="Go ahead..." : CR=2 : GOSUB 1400
  412. 4850  WHILE EOF(3) : A$=INKEY$
  413. 4860  IF A$=CHR$(8) THEN 4895 ELSE IF A$=CHR$(27) THEN RETURN 1200
  414. 4870  IF A$<>"" THEN CR=1 : GOSUB 1400 : GOTO 4850
  415. 4880  WEND : A$=INPUT$(1,#3) : IF A$=CHR$(8) THEN 4895
  416. 4890  CR=1 : GOSUB 1400 : GOTO 4850
  417. 4895  IF POS(0)>1 THEN PRINT BK1$; : PRINT #3,BK$;
  418. 4897  GOTO 4850
  419. 4900             '# Counters ---------------------------------------------------
  420. 4910  GOSUB 1400
  421. 4920  A$="     You are caller #   -->"+STR$(CALLN):GOSUB 1400
  422. 4930  A$="     # of Active msgs   -->"+STR$(LASTR):GOSUB 1400
  423. 4940  A$="     Next msg # will be -->"+STR$(LASTM+1):GOSUB 1400:RETURN
  424. 5000             'Convert Lower Case to Upper Case -----------------------------
  425. 5010  FOR Z=1 TO LEN(Z$)
  426. 5020  MID$(Z$,Z,1)=CHR$(ASC(MID$(Z$,Z,1))+32*(ASC(MID$(Z$,Z,1))>96))
  427. 5030  NEXT Z : RETURN
  428. 6000             'Common Routine to Print  A File ------------------------------
  429. 6010  OPEN "I",#2,FILE$
  430. 6020  IF EOF(2) THEN CLOSE #2:RETURN
  431. 6030  LINE INPUT #2,A$:GOSUB 1400:GOTO 6020
  432. 7000             'Common Routine To Test Fields --------------------------------
  433. 7010  GET 1,R : RR=VAL(MID$(R$,118))
  434. 7020  IF RR<1 THEN DONE=-1:RETURN
  435. 7030  R=R+RR
  436. 7040  IF INSTR(MID$(R$,X,Y),F$) THEN RETURN
  437. 7050  GOTO 7010
  438. 8000            'Process Message Header ----------------------------------------
  439. 8005  GOSUB 1400
  440. 8010  IF MID$(R$,37,3)="ALL" THEN T$="ALL":GOTO 8030
  441. 8020  Z=31 : Z$=MID$(R$,37,31) : GOSUB 8100 : T$=Z$
  442. 8030  Z=25 : Z$=MID$(R$,76,25) : GOSUB 8100 : SUB$=Z$
  443. 8040  Z=31 : Z$=MID$(R$, 6,31) : GOSUB 8100 : FROM$=Z$
  444. 8050  A$="Msg # "+LEFT$(R$,5)+" Dated "+MID$(R$,68,8)+" From : "+FROM$
  445. 8060  GOSUB 1400 : A$="To: "+T$ : GOSUB 1400
  446. 8070  A$="Re: "+SUB$ : GOSUB 1400 : RETURN
  447. 8099             'Remove Spaces That Pad Msg Header
  448. 8100  WHILE MID$(Z$,Z,1)=" ":Z=Z-1:WEND : Z$=LEFT$(Z$,Z) : RETURN
  449. 9000            'Unpack Disk Record --------------------------------------------
  450. 9005  GOSUB 1400
  451. 9010  FOR X=1 TO VAL(MID$(R$,118))-1
  452. 9020  EOL=0 : A=0 : B=0 : C=0
  453. 9030  GET 1 : A=INSTR(R$,CHR$(227)) : A$=LEFT$(R$,A-1) : GOSUB 1400
  454. 9040  B=INSTR(A+1,R$,CHR$(227))
  455. 9050  C=B-(A+1) : IF C<1 THEN C=50:EOL=-1 '50 insures all rightmost characters
  456. 9070  GOSUB 1400 : A=B : GOTO 9040
  457. 9080  CR=1 : GOSUB 1400 : NEXT : GOSUB 1400 : RETURN
  458. 10000             'Sysop's Utilities -------------------------------------------
  459. 10010  A$="Sysop's Utilities :":GOSUB 1400
  460. 10020  A$="  $  Type Comments":GOSUB 1400
  461. 10030  A$="  %  Type Callers":GOSUB 1400
  462. 10040  A$="  ^  Purge File":GOSUB 1400
  463. 10050  A$="  &  Renumber file":GOSUB 1400
  464. 10060  A$="  *  Resurrect a Msg":GOSUB 1400
  465. 10070  A$="  (  Print Msg Headers":CR=2:GOSUB 1400:RETURN
  466. 10100             '$ -----------------------------------------------------------
  467. 10110  FILE$="COMMENTS":GOSUB 6000:RETURN
  468. 10120             '% -----------------------------------------------------------
  469. 10130  FILE$="CALLERS":GOSUB 6000:RETURN
  470. 10200             'Purge -------------------------------------------------------
  471. 10210  CLOSE :NAME "MESSAGES" AS "MESSAGES.BAK" : Q=0 : B=0
  472. 10220  OPEN "R",#1,"MESSAGES.BAK":FIELD #1,128 AS R$
  473. 10230  OPEN "R",#2,"MESSAGES"    :FIELD #2,128 AS RR$
  474. 10240  GET 1
  475. 10250  IF INSTR(R$,CHR$(225))>0 THEN 10300
  476. 10260  IF INSTR(R$,CHR$(227))>0 THEN 10320
  477. 10270  IF INSTR(R$,CHR$(226))>0 THEN 10330
  478. 10280  GOSUB 1400:A$="# of Msgs Purged  :"+STR$(PG):GOSUB 1400
  479. 10285  A$="# of Bytes Purged :"+STR$((LOC(1)*128)-(LOC(2)*128)):GOSUB 1400
  480. 10290  A$="Re-Loading Msg File...":GOSUB 1400:ERASE M:GOSUB 100:RETURN 1200
  481. 10300  A=VAL(MID$(R$,118))
  482. 10310  A$="Msg #"+LEFT$(R$,5)+" copied...":GOSUB 1400
  483. 10320  LSET RR$=R$ : PUT 2 : GOTO 10240
  484. 10330  PG=PG+1 : A$="Msg #"+LEFT$(R$,5)+" purged..." : GOSUB 1400
  485. 10340  GET 1,LOC(1)+VAL(MID$(R$,118)) : GOTO 10250
  486. 10400             'Renumber ----------------------------------------------------
  487. 10450  A$="Renumber starting with OLD msg #":GOSUB 1500:MM=VAL(B$(1))
  488. 10460  IF MM<1 THEN 1450
  489. 10470  A$="Start with NEW #":GOSUB 1500:Y=VAL(B$(1)):YY=Y:IF Y<1 THEN 1460
  490. 10480  FOR Q=1 TO LASTR
  491. 10490  IF M(Q,2)=MM THEN R=M(Q,1) : GOTO 10510
  492. 10500  NEXT : A$="No Msg #"+STR$(MM) : GOSUB 1400 : RETURN
  493. 10510  GET 1,R
  494. 10520  RR=VAL(MID$(R$,118)) : IF RR<1 THEN 10290  'Done
  495. 10530  LSET R$=STR$(Y)+SPACE$(5-LEN(STR$(Y)))+MID$(R$,6)
  496. 10540  PUT 1,LOC(1)
  497. 10550  Y=Y+1 : R=R+RR : GOTO 10510
  498. 10600             'Resurrection ------------------------------------------------
  499. 10610  A$="Msg # to Resurrect":GOSUB 1500:MM=VAL(B$(1)):IF MM<1 THEN 1450
  500. 10620  R=1 : GOSUB 1400
  501. 10630  GET 1,R : RR=VAL(MID$(R$,118))
  502. 10635  IF RR<1 THEN A$="No Msg #"+STR$(MM) :GOSUB 1400 : RETURN
  503. 10640  IF VAL(LEFT$(R$,5))<>MM THEN R=R+RR : GOTO 10630
  504. 10650  IF INSTR(R$,CHR$(226))=0 THEN 10680
  505. 10660  LSET R$=LEFT$(R$,115)+CHR$(225)+MID$(R$,117) : PUT 1,LOC(1)
  506. 10670  A$="Msg #"+STR$(MM)+" is now alive and well." : GOSUB 1400 : GOTO 10290
  507. 10680  A$="Msg #"+STR$(MM)+" is not Dead." : GOSUB 1400 : RETURN
  508. 10800             'Print Msg Header --------------------------------------------
  509. 10810  R=1
  510. 10820  GET 1,R : RR=VAL(MID$(R$,118)) : IF RR<1 THEN RETURN
  511. 10830  A$=R$  : GOSUB 1400 : R=R+RR : GOTO 10820
  512. 12000             'Time -------------------------------------------------------
  513. 12010  GOSUB 1400
  514. 12040   H=VAL(LEFT$(TI$,2))  : M=VAL(MID$(TI$,4,2))  : S=VAL(MID$(TI$,7,2))
  515. 12050  HH=VAL(LEFT$(TIME$,2)):MM=VAL(MID$(TIME$,4,2)):SS=VAL(MID$(TIME$,7,2))
  516. 12060  IF S=<SS THEN SSS=SS-S ELSE SSS=60-(S-SS)
  517. 12070  IF M=<MM THEN MMM=MM-M ELSE MMM=60-(M-MM)
  518. 12080  IF H=<HH THEN HHH=HH-H ELSE HHH=24-(H-HH)
  519. 12090  IF HHH>12 THEN HHH=HHH-12:P$="PM" ELSE P$="AM"
  520. 12100  A$="It is now "+TIME$ : CR=2 : GOSUB 1400
  521. 12110  A$="You have been on for" : CR=1 : GOSUB 1400
  522. 12120  IF HHH>0 THEN A$=STR$(HHH)+" Hours" : CR=1 : GOSUB 1400
  523. 12130  A$=STR$(MMM)+" Minutes and "+STR$(SSS)+" Seconds.":CR=2:GOSUB 1400
  524. 12140  A$="Character count :  WHO CARES ?":CR=2:GOSUB 1400
  525. 12150  A$="Thanks for calling, "+FIRST$ : CR=2 : GOSUB 1400 : CLOSE #2,3
  526. 12160  IF HHH<1 OR SYSOP THEN 12180
  527. 12170  OPEN "A",#2,"LONGCALR":WRITE #2,NAM$,D$,HHH,MMM:CLOSE #2
  528. 12180  IF TRIES>5 THEN 200 ELSE RUN
  529. 12500            'Log-Off Weasels ---------------------------------------------
  530. 12510  GOSUB 1400 : A$="No one likes a wise-guy." : CR=2 : GOSUB 1400
  531. 12520  A$="You are no longer welcome here." : GOSUB 1400 : CLOSE #2,3 : GOTO 200
  532. 12530  GOSUB 1400 : A$="You are a Weasel." : CR=2 : GOSUB 1400 : GOTO 12520
  533. 13000             'Error Trapping ---------------------------------------------
  534. 13010  SOUND 2000,0.5
  535. 13020  'PRINT "+++ Error";ERR;"  in line ";ERL
  536. 13025  IF ERL=238  THEN RESUME 238
  537. 13030  IF ERL=1220 THEN RESUME 1230
  538. 13035  IF ERL=1560 THEN CLOSE : RUN
  539. 13040  IF ERL=1840 THEN RESUME 1850
  540. 13060  IF ERL=2030 THEN ERASE A$:RESUME 2030
  541. 13070  IF ERL=2810 THEN ERASE C$:RESUME 2810
  542. 13080  IF ERL=3540 THEN RESUME 3550
  543. 13090  IF ERL=3730 THEN RESUME 3710
  544. 13100  IF ERL=3800 THEN RESUME 3810
  545. 13110  IF ERL=3850 THEN R$="":COL=0:RESUME 3700
  546. 13120  IF ERL=8100 THEN Z$="" : RESUME NEXT
  547. 13130  IF ERR=3    THEN RESUME 1200
  548. 13135  IF ERR=7    THEN RESUME NEXT
  549. 13140  A$="You have located a software bug." : GOSUB 1400
  550. 13150  A$="Please leave a comment or a msg for SYSOP that" : GOSUB 1400
  551. 13160  A$="Error "+STR$(ERR)+" occured in Line "+STR$(ERL) : GOSUB 1400
  552. 13170  A$="Thank You..." : GOSUB 1400 : PRINT : GOTO 1200
  553.